open Ast
open OpBloc
open Utils

(*tri topo prend en argument un bloc et renvoit un Array qui associe a un noeud sa place dans le tri topologique 
(tout les noeuds doivent apparaitre, ceux de type IN et ceux de type REG aussi. Si tu tombes sur un truc de type INIT tu failwith un truc)*)
type couleur=Noir|Blanc|Gris;;

let optimize bloc =
  let toKeep=Array.make (bloc.nbElem) true in
  let kept=ref (bloc.nbElem) in
  let color=Array.make (bloc.nbElem) Blanc in
  let rec parcours i j= match color.(j) with
    |Noir | Gris->()
    |Blanc-> color.(j)<-Gris;
	List.iter (parcours j) (bloc.ladj.(j)); 
	if bloc.noeuds.(j)=IN then begin
	  bloc.ladj.(i)<-(bloc.ladj.(j)@(List.filter (fun x->not(x=j)) bloc.ladj.(i)) );
	  toKeep.(j)<-false;
	  if List.mem j bloc.sorties then begin
	    bloc.sorties<-i::bloc.sorties;
	    bloc.names.(i)<-bloc.names.(j)
	  end;
	  decr kept;
  	end;			 	 
	color.(j)<-Noir
  in
    List.iter (fun x-> List.iter (parcours x) bloc.ladj.(x)) (bloc.entrees@bloc.bools@bloc.rego);
    
    let nvLadj = Array.make !kept [] in
    let nvNoeuds = Array.make (!kept) INIT in
    let nvNames =Array.make !kept "" in
    let nvPlace=Array.make (bloc.nbElem) (-1) in
    let nvLink=Array.make !kept (-1) in
    let p=ref 0 in
      for j=0 to (bloc.nbElem -1) do
	if toKeep.(j) then begin 
	  nvPlace.(j)<-(!p);
	  nvNoeuds.(!p)<-bloc.noeuds.(j);
	  nvNames.(!p)<-bloc.names.(j);
	  incr p end
      done;
      let f x= nvPlace.(x) in
	for j=0 to (bloc.nbElem-1) do
	  if toKeep.(j) then begin
	    if bloc.noeuds.(j)==REGOUT then begin
	      nvLink.(nvPlace.(j))<-nvPlace.(bloc.link.(j));
	    end;
	    nvLadj.(nvPlace.(j))<-( List.map f bloc.ladj.(j) );
	  end
	done;
	bloc.entrees<-List.map f bloc.entrees;
	bloc.sorties<-List.map f bloc.sorties;
	bloc.ladj<-nvLadj;
	bloc.noeuds<-nvNoeuds;
	bloc.names<-nvNames;
	bloc.link<-nvLink;
	bloc.nbElem<- !kept;;	

		 			
let tri_top bloc=
  let n=bloc.nbElem in
  let k=ref 0 in 
  let color=Array.make n Blanc in
  let tri= Array.make n (-1) in
  let rec parcours i=
    try (
      match color.(i) with
	|Noir->()
	|Gris->failwith "boucle conditionelle"
	|Blanc-> 
	  color.(i)<-Gris;
	  if bloc.noeuds.(i)=INIT then failwith "INIT detecte";
	  if bloc.noeuds.(i)<>REG then
	    List.iter parcours bloc.ladj.(i);
	  tri.(i)<- !k; 
	  k:= !k +1;
	  color.(i)<-Noir)
    with _->()
  in
  List.iter parcours ((bloc.entrees)@bloc.bools@bloc.rego);
    (Array.map (fun x-> !k -(x+1)) tri,!k-1);;
(*le tableau renvoie les dates de fin, ce qui constitue le tri topologique. Vu l'orientation du graphe, il faut prendre les dates par ordre décroissant!
Remarquons que: les IN en trop restent a -1 de même que les noeuds jamais visités, on peut donc dans la suite les ignorer*)


let revert b (accessible,v) =
  let taille=Array.length accessible in
  let newLadj=Array.make taille [] in
    for noeud=0 to (taille-1) do
      if accessible.(noeud)<=v then
	List.iter (function x -> newLadj.(x)<-noeud::newLadj.(x)) b.ladj.(noeud)
    done;
    b.ladj<-newLadj;
    b;;
